home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 081-090 / amok89 / amigaguide / nodehost.mod < prev    next >
Text File  |  1993-11-04  |  10KB  |  345 lines
  1. MODULE NodeHost;
  2.  
  3. (*---------------------------------------------------------------------------
  4. ** Written by David N. Junod
  5. **
  6. ** Example of a Dynamic Node Host.  This example is useful for determining
  7. ** what nodes an AmigaGuide database is calling when it brings up the
  8. ** "Can't locate node" requester.
  9. **
  10. ** I use it when I'm writing help files for AppShell applications...
  11. **
  12. ** This is a translation of the NodeHost.c example supplied with the
  13. ** AmigaGuide v1.24 package.
  14. **---------------------------------------------------------------------------
  15. ** Oberon: Amiga-Oberon v3.00, F. Siebert / A+L AG
  16. **---------------------------------------------------------------------------
  17. ** 14-Apr-93 [lars] created
  18. ** 14-Apr-93 [lars] actual
  19. **---------------------------------------------------------------------------
  20. *)
  21.  
  22. IMPORT ag:AmigaGuide, Dos, e:Exec, gr:Graphics, i:Intuition, sys:SYSTEM,
  23.        Utility,
  24.        (* $IF Debug *) Debug, (* $END *)
  25.        io, NoGuru, Requests;
  26.  
  27. (*-------------------------------------------------------------------------*)
  28.  
  29. CONST
  30.   TempNode = "This AmigaGuideHost is example, that can also\nbe used as a debugging tool.\n";
  31.   Link       = "Link: ";
  32.  
  33.   Topaz8  = gr.TextAttr (sys.ADR("topaz.font"), 8, SHORTSET{}, SHORTSET{} );
  34.   Topaz8B = gr.TextAttr (sys.ADR("topaz.font"), 8, SHORTSET{gr.bold}, SHORTSET{} );
  35.  
  36. (*-------------------------------------------------------------------------*)
  37. PROCEDURE ^ dispatchAmigaGuideHost ( h     : Utility.HookPtr;
  38.                      db  : e.APTR;
  39.                      msg : e.APTR
  40.                    ) : LONGINT;
  41.  
  42. PROCEDURE Main ();
  43.   VAR
  44.     hook : Utility.Hook;
  45.     hh : ag.AmigaGuideHostPtr;
  46. BEGIN
  47.   (* Initialize the hook *)
  48.   Utility.InitHook (sys.ADR(hook), dispatchAmigaGuideHost);
  49.  
  50.   (* Add the AmigaGuideHost to the system *)
  51.   hh := ag.AddAmigaGuideHost (hook, "ExampleHost", NIL);
  52.   IF hh # NIL THEN
  53.     io.WriteString ("Added AmigaGuideHost $");
  54.     io.WriteHex (sys.VAL(sys.ADDRESS, hh), 1); io.WriteLn;
  55.  
  56.     (* Wait until we're told to quit *)
  57.     sys.SETREG(0, e.Wait (LONGSET{Dos.ctrlC}));
  58.  
  59.     io.WriteString ("Remove AmigaGuideHost $");
  60.     io.WriteHex (sys.VAL(sys.ADDRESS, hh), 1); io.WriteLn;
  61.  
  62.     (* Try removing the host *)
  63.     WHILE ag.RemoveAmigaGuideHost (hh, NIL) > 0 DO
  64.       (* Wait a while *)
  65.       io.Write (".");
  66.       Dos.Delay (250);
  67.     END;
  68.     io.WriteLn;
  69.   ELSE
  70.     io.WriteString ("Couldn't add AmigaGuideHost\n");
  71.   END;
  72. END Main;
  73.  
  74. (*-------------------------------------------------------------------------*)
  75. (***** Common tag manipulation routines ************************************)
  76.  
  77. (* $OvflChk- for pointer arithmetics *)
  78. PROCEDURE nextTagItem (VAR tp : Utility.TagItemPtr) : Utility.TagItemPtr;
  79.   TYPE
  80.     TIA = ARRAY 2 OF Utility.TagItem;
  81.     TIP = UNTRACED POINTER TO TIA;
  82.   VAR
  83.     nextti : TIP;
  84. BEGIN
  85.   (* 'tp' already holds "next" item in list *)
  86.   nextti := sys.VAL (TIP, tp);
  87.  
  88.   (* walk all TAG_MORE and TAG_IGNORE chaining *)
  89.   WHILE  nextti # NIL DO
  90.     CASE sys.VAL(LONGINT, nextti[0].tag) OF
  91.     | Utility.more: nextti := nextti[0].data;
  92.     | Utility.skip:
  93.       (* nextti := sys.ADR (nextti[1+nextti[0].data]); *)
  94.       nextti := sys.VAL ( TIP,
  95.               sys.VAL(LONGINT, nextti)
  96.                 + (1+sys.VAL(LONGINT, nextti[0].data))
  97.                   * SIZE(Utility.TagItem)
  98.             );
  99.     | Utility.ignore: nextti := sys.ADR (nextti[1]);
  100.     | Utility.done: tp := NIL; RETURN tp;
  101.     ELSE (* a normal tag item     *)
  102.       tp := sys.ADR (nextti[1]);
  103.       RETURN sys.VAL(Utility.TagItemPtr, nextti);
  104.     END;
  105.   END;
  106.   tp := NIL;
  107.   RETURN tp;
  108. END nextTagItem;
  109. (* $OvflChk= *)
  110.  
  111. (*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*)
  112. PROCEDURE findTagItem ( tag : Utility.Tag;
  113.             ti  : Utility.TagItemPtr
  114.               ) : Utility.TagItemPtr;
  115.  
  116.   VAR
  117.     tistate : Utility.TagItemPtr;
  118. BEGIN
  119.   tistate := ti;
  120.  
  121.   REPEAT
  122.     ti := nextTagItem (tistate);
  123.   UNTIL (ti = NIL) OR (ti.tag = tag);
  124.   RETURN ti;
  125. END findTagItem;
  126.  
  127. (*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*)
  128. PROCEDURE getTagData ( tag : Utility.Tag;
  129.                deflt : LONGINT;
  130.                ti : Utility.TagItemPtr
  131.              ) : LONGINT;
  132. BEGIN
  133.   ti := findTagItem ( tag, ti );
  134.   IF ti # NIL THEN RETURN ti.data; END;
  135.   RETURN deflt;
  136. END getTagData;
  137.  
  138. (*-------------------------------------------------------------------------*)
  139. PROCEDURE Display (onm : ag.OpNodeIOPtr);
  140.  
  141. (* We really need the screen, rectangle, and pen spec. *)
  142.  
  143.   TYPE
  144.     PenA = ARRAY i.shadowPen+1 OF SHORTINT;
  145.     PenP = UNTRACED POINTER TO PenA;
  146.   VAR
  147.     attrs : Utility.TagItemPtr;
  148.     it1, it2 : i.IntuiText;
  149.     rect : gr.RectanglePtr;
  150.     nw : i.NewWindow;
  151.     scr : i.ScreenPtr;
  152.     msg : i.IntuiMessagePtr;
  153.     win : i.WindowPtr;
  154.     pens : PenP;
  155.     going : BOOLEAN;
  156.     width : LONGINT;
  157.     w, h, dif : INTEGER;
  158.  
  159. BEGIN
  160.   attrs := onm.attrs;
  161.   rect := NIL;
  162.   scr := NIL;
  163.   pens := NIL;
  164.   going := TRUE;
  165.   width := 0;
  166.   w := 640;
  167.   h := 200;
  168.  
  169.   (* Get attributes, could be NIL *)
  170.   IF attrs # NIL THEN
  171.     scr  := sys.VAL (i.ScreenPtr, getTagData (ag.screen, NIL, attrs));
  172.     pens := sys.VAL(PenP, getTagData (ag.pens, NIL, attrs));
  173.     rect := sys.VAL (gr.RectanglePtr,  getTagData (ag.rectangle, NIL, attrs));
  174.   END;
  175.  
  176.   (* Prepare the IntuiText *)
  177.   IF pens # NIL THEN it2.frontPen := pens[i.shadowPen];
  178.   ELSE             it2.frontPen := 1;
  179.   END;
  180.   it1.frontPen := it2.frontPen;
  181.   it1.drawMode := gr.jam1;
  182.   it2.drawMode := gr.jam1;
  183.   it1.iTextFont := sys.ADR(Topaz8);
  184.   it2.iTextFont := sys.ADR(Topaz8B);
  185.   it1.iText := sys.ADR(Link);
  186.   it2.iText := onm.node;
  187.  
  188.   (* Get the width of the first string *)
  189.   width := i.IntuiTextLength (it1);
  190.   it2.leftEdge := SHORT(width);
  191.  
  192.   (* Add in the length of the node name *)
  193.   INC (width, i.IntuiTextLength (it2));
  194.  
  195.   (* Link the text *)
  196.   it1.nextText := sys.ADR(it2);
  197.  
  198.   (* Prepare the window *)
  199.   nw.idcmpFlags := LONGSET{i.vanillaKey, i.mouseButtons};
  200.   nw.flags := LONGSET{i.borderless, i.noCareRefresh, i.activate} + i.smartRefresh;
  201.   nw.width := SHORT(8 + width + 8);
  202.   nw.height := 16;
  203.   nw.screen := scr;
  204.   IF scr # NIL THEN nw.type := i.customScreen;
  205.   ELSE nw.type := {i.wbenchScreen};
  206.   END;
  207.  
  208.   (* Cache the screen size *)
  209.   IF scr # NIL THEN
  210.     w := scr.width;
  211.     h := scr.height;
  212.   END;
  213.  
  214.   (* See if we have a open help window *)
  215.   IF rect # NIL THEN
  216.     (* Center the window within the help window *)
  217.     nw.leftEdge := rect.minX + ((rect.maxX - nw.width) DIV 2);
  218.     nw.topEdge    := rect.minY + ((rect.maxY - nw.height) DIV 2);
  219.  
  220.   (* No help window, so go off the screen *)
  221.   ELSIF scr # NIL THEN
  222.     (* Center the window horizontally under the mouse and place it
  223.      * vertically over the mouse position. *)
  224.     nw.leftEdge := scr.mouseX - (nw.width DIV 2);
  225.     nw.topEdge := scr.mouseY - (nw.height - 2);
  226.  
  227.     (* Make sure the window can open *)
  228.     IF nw.leftEdge < 0 THEN nw.leftEdge := 0; END;
  229.     IF nw.topEdge < 0 THEN nw.topEdge := 0; END;
  230.   END;
  231.  
  232.   (* Make sure window is on-screen *)
  233.   dif := (nw.leftEdge + nw.width) - w;
  234.   IF dif > 0 THEN DEC (nw.leftEdge, dif); END;
  235.   dif := (nw.topEdge + nw.height) - h;
  236.   IF dif > 0 THEN DEC (nw.topEdge, dif); END;
  237.  
  238.   (* Open the temporary window *)
  239.   win := i.OpenWindow (nw);
  240.   IF win # NIL THEN
  241.     (* Clear the window background *)
  242.     IF pens # NIL THEN gr.SetAPen (win.rPort, pens[i.shadowPen]);
  243.     ELSE           gr.SetAPen (win.rPort, 1);
  244.     END;
  245.     gr.RectFill (win.rPort, 0, 0, (win.width - 1), (win.height - 1));
  246.     IF pens # NIL THEN gr.SetAPen (win.rPort, pens[i.shinePen]);
  247.     ELSE           gr.SetAPen (win.rPort, 2);
  248.     END;
  249.     gr.RectFill (win.rPort, 1, 1, (win.width - 2), (win.height - 2));
  250.  
  251.     (* Print the text *)
  252.     i.PrintIText (win.rPort, it1, 8, 4);
  253.  
  254.     (* Keep on going til the going gets tough *)
  255.     WHILE going DO
  256.       (* Wait around for something eventful *)
  257.       sys.SETREG(0, e.Wait (LONGSET{win.userPort.sigBit}));
  258.  
  259.       (* Pull each message and handle it *)
  260.       LOOP
  261.     msg := e.GetMsg (win.userPort);
  262.     IF msg # NIL THEN EXIT; END;
  263.     IF i.mouseButtons IN msg.class THEN  (* Stop if we were touched *)
  264.       IF msg.code = i.selectDown THEN going := FALSE; END;
  265.     ELSIF i.vanillaKey IN msg.class THEN (* Stop on significant keypress *)
  266.       IF (msg.code = 27) OR (msg.code = 13) THEN going := FALSE; END;
  267.     END;
  268.  
  269.     e.ReplyMsg (msg);
  270.       END;
  271.     END;
  272.  
  273.     (* Close the window *)
  274.     i.CloseWindow (win);
  275.   END;
  276. END Display;
  277.  
  278. (*-------------------------------------------------------------------------*)
  279. PROCEDURE * dispatchAmigaGuideHost ( h     : Utility.HookPtr;
  280.                      db  : e.APTR (* e.STRPTR *);
  281.                      msg : e.APTR (* ag.Msg *)
  282.                    ) : LONGINT;
  283.  
  284. (* This is your AmigaGuideHost dispatch hook.  It will never run on your
  285.  * own process. *)
  286.  
  287.   VAR
  288.     onm : ag.OpNodeIOPtr;
  289.     retval : LONGINT;
  290.     ofh : ag.OpFindHostPtr;
  291. BEGIN
  292.   onm := sys.VAL (ag.OpNodeIOPtr, msg);
  293.   retval := e.false;
  294.  
  295.   CASE onm.method.ID OF
  296.   | ag.findNode : (* Does this node belong to you? *)
  297.      ofh := sys.VAL (ag.OpFindHostPtr, msg);
  298.  
  299.      (* See if they want to find our table of contents *)
  300.      IF Utility.Stricmp (ofh.node^, "main") = 0 THEN
  301.        (* Return TRUE to indicate that it's your node, else return FALSE. *)
  302.        retval := e.true;
  303.      ELSE
  304.        (* Display the name of the node *)
  305.        Display (onm);
  306.  
  307.        (* Return TRUE to indicate that it's your node, else return FALSE. *)
  308.        retval := e.false;
  309.      END;
  310.   | ag.openNode : (* Open a node. *)
  311.      (* See if they want to display our table of contents *)
  312.      IF Utility.Stricmp (onm.node^, "main") = 0 THEN
  313.        (* Provide the contents of the node *)
  314.        onm.docBuffer := sys.ADR(TempNode);
  315.        onm.buffLen := SIZE (TempNode); (* should be strlen() for variant data! *)
  316.      ELSE
  317.        (* Display the name of the node *)
  318.        Display (onm);
  319.  
  320.        (* Indicate that we want the node removed from our database,
  321.     * and that we handled the display of the node *)
  322.        onm.flags := onm.flags + LONGSET{ag.clean, ag.done};
  323.      END;
  324.  
  325.      (* Indicate that we were able to open the node *)
  326.      retval := e.true;
  327.   | ag.closeNode : (* Close a node, that has no users. *)
  328.      (* Indicate that we were able to close the node *)
  329.      retval := e.true;
  330.   | ag.expunge : (* Free any extra memory *)
  331.   ELSE
  332.   END;
  333.  
  334.   RETURN retval;
  335. END dispatchAmigaGuideHost;
  336.  
  337. (*-------------------------------------------------------------------------*)
  338.  
  339. BEGIN
  340.   Requests.Assert (ag.base # NIL, "Can't open amigaguide.library");
  341.   Main;
  342. END NodeHost.
  343.  
  344. (***************************************************************************)
  345.